home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 20
/
Cream of the Crop 20 (Terry Blount) (1996).iso
/
program
/
commio0b.zip
/
DOORIO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-05-13
|
34KB
|
996 lines
{$X+}
unit DOORIO;
{
This unit is a companion to the COMMIO communications unit.
Written by Jason Morriss a.k.a. Lief O'Pardy
Copyright (C) 1995,1996 by Jason Morriss
This unit has a group of procedures and functions for getting input from
the user in various ways, and writting text in various ways, including
some animation.
Some of the following routines CAN NOT be used over the modem since there's
no way to "TELL" the other computer how to do it. They are here because
this unit used to be my own IO unit for my "normal" programs, i just
converted it for these DOOR routines, and then added more routines
... enjoy.
}
INTERFACE
uses crt, commio;
Type
TCharSet = Set of Char;
Tauto = (noauto,upper,lower,smart);
Twriter = (nofx,wipe1,fadein,fadeout);
Var
Pause_Proc: procedure(s:string);
{ More_Proc : function(s:string;chs:tcharset):TMoreResults;}
Const Charset : tcharset = [#32..#232,#234..#255];
Const NumSet : tcharset = ['0'..'9','-'];
Const
{ pausestr : string[100] = 'Θ|1ΘB <PAUSE> Θ|0';
pausestrl : byte = 9;{}
inserton : boolean = false;
{--[v- how the string is displayed with putstr/xy() ]--}
writer : Twriter = nofx;
dlay : array[Twriter] of word = (0,10,100,100);
{--[v- if true Getstr() will echo "secretchar" (used for passwords) ]--}
secret : boolean = false;
secretchar: char = '█';
{--[v- The Getstr() string will be filtered according to Tauto ]--}
autocaps : Tauto = noauto;
{--[v- if true input will be highlighted according to the const BGCol,
when using most input routines ]--}
highlight : boolean = true;
{--[v- These are the allowable exit keys for getstr(): ]--}
normalexitkeys : tcharset = [#27,#13]; {esc, enter}
{--[v- Extended keys are the ones who send #0 first, then the scancode ]--}
extendedexitkeys : tcharset = [];
FGCol : Byte = 15; {white} { Fg color for most input routines }
BGCol : Byte = 1; {blue} { Bg color for most input routines }
DVseg : word = $B800; {.$B800=color; $B000 for mono}
DVofs : word = $0000; {the ofs is needed incase i/you create routines
that will write to a virtual page, virtual pages
will not always start at 0000.}
const
nomemory = 1;
filenotfound = 2;
procedure terminate(s:string);
{^ Halts the program with the Error String "s". }
function CommaInt(number:longint):string;
{^ Inserts comma's into a number and returns a string of the number with the
commas. ie: s:=Commint(1000000); (* s='1,000,000' *) Makes Larger numbers
easier to read. }
function padFstr(s:string; ch:char; len:byte):string;
{^ Pad the front of the string with CH, up to LEN. }
function padEstr(s:string; ch:char; len:byte):string;
{^ Pad the end of the string with CH, up to LEN. }
function istr(n:longint; pad:byte):string;
{^ converts a number to a string.
pad = how many 0's will be padded in front of the string, to make
the number a certain length. ie: istr(45,3) = '045'}
function sint(s:string):longint;
{^ converts a string to a number. if the string is invalid, 0 is returned. }
function CSLen(s:string):byte;
{^ returns the length of the string, not including any of the "Θ" control
codes. }
function UpChar(Ch:Char):Char;
{^ converts the Char to upper case. this also supports some foreign chars. }
function LowChar(Ch:Char):Char;
{^ converts the char to lower case. " " " " " ". }
function UpCaseStr(s:string):string;
{^ conerts a string to upper case; uses Upchar. }
function LowCaseStr(s:string):string;
{^ converts a string to lower case; uses Lowchar. }
function SmartCaseStr(s:string):string;
{^ converts a string to a PROPERLY capitalized string. only useful for
names. ie: "jasON moRRisS" = "Jason Morriss". }
procedure hidecursor;
{^ LOCAL ONLY: turns the cursor off; you can't see it on the screen, but its
still there. }
procedure showcursor;
{^ LOCAL ONLY: turns the cursor on, if it was off. }
{function whereX:byte;
{^ LOCAL ONLY: returns the X position of the cursor. This is just like TP's
WhereX, except it is NOT window relitive. }
{function whereY:byte;
{^ LOCAL ONLY: returns the Y position of the cursor. This is just like TP's
WhereY, except it is NOT window relitive. }
procedure SetCursorSize(Top,Bot:Byte);
{^ LOCAL ONLY: Set the size of the cursor. top=top scanline; bot=bottom
scanline of cursor. Both in the range of 1..8. (7,8)="normal" cursor,
(1,8)=block cursor... }
procedure KillBlanks(var s:string);
{^ Kills ALL blanks in the string. }
procedure KillExtraBlanks(var s:string);
{^ Kills any blanks in FRONT of, and at the END of the string. }
function AreYouSureY : char;
{^ Special procedure. Displays a colored "[Y,n]" prompt and returns when the
user presses either: 'Y','N',<enter>. If <enter> is pressed then 'Y' is
returned. }
function AreYouSureN : char;
{^ Special procedure. Displays a colored "[y,N]" prompt and returns when the
user presses either: 'Y','N',<enter>. If <enter> is pressed then 'N' is
returned. }
procedure GetPW(var st:string; len:byte);
{^ Special procedure. Get a password from the user. the character echoed
is in the "secretchar" variable above. }
procedure GetInt(var num:longint; hotkey:boolean; l:longint; h:longint);
{^ Special procedure. Get a number from the user. l=lowest # allowed,
h=highest # allowed. If hotkey is true then the user will not always
have to push enter after entering the number. example: if you want to
get a number in the range of 1 to 500 and the user enters 325 then he/she
won't have to hit enter, it will return the 325, since if the user were to
enter ANY other number after the 5 (in 325) then the number would be
larger then the maximum you set of 500. But if the user enters something
like 20 then he/she will have to push enter. otherwise it will wait until
the user pushes enter, to return the value. got it? negitive numbers are
allowed also. }
function HotKey(CharSet:TCharSet):char;
{^ Special procedure. Get A char from the user. CharSet is the set of
allowable characters to be pressed, any other character not in this
set is ignored. As soon as one of the allowed chars is read, it returns
that char. This does not echo any characters. }
function GetStr(var DestStr:String; MaxLen:Byte; CharSet:TCharSet):char;
{^ Get a string from the user. If DestStr is not empty then the user starts
with that string, and the cursor starts at the end of the string (this
will write the string to the screen). MaxLen is the maximum allowed
length of the string (duh). CharSet is the set of chars allowed to be
entered into the string. Also, look at the front of this unit, there are
a bunch of other variables that effect the output of this routine. This
function returns the char that terminated the function. }
procedure PutStr(S:string);
{^ Powerful writting routine. Color codes can be put directly into the
string to change colors easily. Also there are a few animation Codes
also, you can easily write your own animation procedures and include them
also; that ofcourse requires a recompilation.
The CODE is: "Θ" (alt+233).
To change colors, the CODE comes first then one of the following chars:
--------------------------------------------
0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F (UPPERCASE!)
a,b,c,d,e,f,g,h (LOWERCASE!)
[,]
--------------------------------------------
The first line has all the values for changing the Foreground color.
They must be UPPERCASE. The values are the standard TP set, in
that: 0=black, 1=blue, 2=green, ..., F (15)=white.
The second line has all the values for changing the Background color.
They must be LOWERCASE. The values here go like: a=black, b=blue,
c=green, d=cyan, e=red, f=magenta, g=brown, h=lgtgray, the same order